home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / NRCOBOL1g / COBFILES / CB02DJC.CBL < prev    next >
Encoding:
Text File  |  1999-07-05  |  8.4 KB  |  256 lines
  1.       *********************************
  2.       **    Yet another cobol program**
  3.       ** this one is for sorts       **
  4.       **    and ctrl-breaks          **
  5.       *********************************
  6.  
  7.       *****   **************************
  8.        IDENTIFICATION DIVISION.
  9.        PROGRAM-ID.     CB02DJC.
  10.        AUTHOR.         DAVID-C.
  11.        DATE-WRITTEN.   5/26/99.
  12.       *****  ***************************
  13.  
  14.  
  15.       **********************************
  16.        ENVIRONMENT DIVISION.
  17.  
  18.        CONFIGURATION SECTION.
  19.        SOURCE-COMPUTER.   SLAP-HAPPY-WIN-BOX.
  20.       *OBJECT-COMPUTER.   THE-SAME-MICROSLOP-BOX-IT-WAS-WRITTEN-ON.
  21.       *************
  22.  
  23.       * I LIKE TO TEASE MY COBOL INSTRUCTOR ABOUT WIN95
  24.       * ANYWAY, THE ONLY CHANGES I MADE WERE TO THE FILE ASSIGNS
  25.       * ALSO, C. , I APOLOGISE FOR THE CARRAGE RETURNS, MICROFOCUS
  26.       *  PUT THEM IN THERE, AND NRCOBOL SEEMS TO IGNORE THEM TOO! 8)
  27.  
  28.        INPUT-OUTPUT SECTION.
  29.        FILE-CONTROL.
  30.            SELECT SORTWORK-FILE ASSIGN 'RAM:DJC.DAT'
  31.            FILE STATUS IS SORTWORK-FILE-STATUS.
  32.  
  33.            SELECT SOURCE-FILE ASSIGN TO 'RAM:SET2.DAT'
  34.            FILE STATUS IS SOURCE-FILE-FILE-STATUS.
  35.  
  36.            SELECT SORTED-FILE ASSIGN TO 'RAM:SORTED.SRT'
  37.            FILE STATUS IS SORTED-FILE-STATUS.
  38.  
  39.            SELECT PRINTER-FILE ASSIGN TO 'RAM:CB02DJC.RPT'
  40.            FILE STATUS IS PRINTER-FILE-STATUS.
  41.  
  42.       **********************************
  43.  
  44.        DATA DIVISION.
  45.        FILE SECTION.
  46.  
  47.        FD  SOURCE-FILE.
  48.        01  JOB-RECORD         PIC X(67).
  49.  
  50.        FD  PRINTER-FILE.
  51.        01  PRINTER-RECORD     PIC X(73).
  52.  
  53.        SD  SORTWORK-FILE.
  54.        01  SWK-RECORD.
  55.            05 FILLER          PIC X(8).
  56.            05 SWR-JOB-NUM     PIC X(2).
  57.            05 FILLER          PIC X(57).
  58.  
  59.        FD  SORTED-FILE.
  60.        01  SORTED-RECORD.
  61.            05  FILLER         PIC X(8).
  62.            05  SF-JOB-NUMBER     PIC X(2).
  63.            05  SF-SUB-ASM-NUM    PIC X(2).
  64.            05  FILLER         PIC X(40).
  65.            05  SF-SUB-ASM-CODE   PIC 9(1).
  66.            05  FILLER         PIC X(4).
  67.            05  SF-NEEDED      PIC 9(2).
  68.            05  FILLER         PIC X(4).
  69.            05  SF-SUB-ASM-COST   PIC 99V99.
  70.  
  71.        WORKING-STORAGE SECTION.
  72.  
  73.        01  WS-STATUS.
  74.            05 SORTWORK-FILE-STATUS    PIC 99.
  75.            05 SOURCE-FILE-FILE-STATUS PIC 99.
  76.            05 SORTED-FILE-STATUS      PIC 99.
  77.            05 PRINTER-FILE-STATUS     PIC 99.
  78.  
  79.        01  HEADING-1.
  80.            05  CC             PIC X(1).
  81.            05  H1-DATE        PIC X(8) value "18/04/99".
  82.            05  FILLER         PIC X(17) VALUE SPACES.
  83.            05  FILLER         PIC X(19) VALUE
  84.                         'JOB ASSEMBLY REPORT'.
  85.            05  FILLER         PIC X(18) VALUE SPACES.
  86.            05  FILLER         PIC X(5)  VALUE 'PAGE '.
  87.            05  H1-PAGE-NUM    PIC ZZ9.
  88.  
  89.        01  HEADING-2          PIC X(73)  VALUE
  90.            '  JOB   SUB-ASSEMBLY   SUB-ASSEMBLY    QUANTITY  SUB-ASSEMB
  91.       -'LY  TOTAL    '.
  92.  
  93.        01  HEADING-3          PIC X(73)  VALUE
  94.            'NUMBER     NUMBER         STATUS        NEEDED       COST
  95.       -'     COST'.
  96.  
  97.        01  DETAIL-LINE.
  98.  
  99.            05  CC             PIC X(1).
  100.            05  FILLER         PIC X(2) VALUE SPACES.
  101.            05  DL-JOB-NUM     PIC X(2).
  102.            05  FILLER         PIC X(9) VALUE SPACES.
  103.            05  DL-ASM-NUM     PIC X(2).
  104.            05  FILLER         PIC X(7) VALUE SPACES.
  105.            05  DL-ASM-STAT    PIC X(13).
  106.            05  FILLER         PIC X(7) VALUE SPACES.
  107.            05  DL-NEEDED      PIC Z9.
  108.            05  FILLER         PIC X(8) VALUE SPACES.
  109.            05  DL-SUB-COST    PIC ZZ.99.
  110.            05  FILLER         PIC X(5)    VALUE SPACES.
  111.            05  DL-TOTAL-COST  PIC Z,ZZZ.99.
  112.  
  113.        01  TOTAL-ONE.
  114.  
  115.            05  CC             PIC X(1).
  116.            05  FILLER         PIC X(28)    VALUE SPACES.
  117.            05  FILLER         PIC X(11)    VALUE
  118.                'JOB NUMBER '.
  119.            05  T1-JOB-NUM     PIC XX.
  120.            05  FILLER         PIC X(3)     VALUE ' - '.
  121.            05  FILLER         PIC X(10)    VALUE 'TOTAL COST'.
  122.            05  FILLER         PIC X(7)     VALUE SPACES.
  123.            05  T1-JOB-TOTAL   PIC ZZ,ZZZ.99.
  124.            05  FILLER         PIC X(2)     VALUE '* '.
  125.  
  126.        01  TOTAL-TWO.
  127.            05  CC             PIC X(1).
  128.            05  FILLER         PIC X(28)    VALUE SPACES.
  129.            05  FILLER         PIC X(32)    VALUE
  130.              'FINAL TOTAL - ALL JOBS         '.
  131.            05  T2-FINAL-TOTAL PIC ZZZ,ZZZ.99.
  132.            05  FILLER         PIC X(2)     VALUE '**'.
  133.  
  134.  
  135.        01  FINAL-LINE.
  136.            05  CC             PIC X(1).
  137.            05  F1-DASHES      PIC X(43)    VALUE
  138.              '-------------------------------------------'.
  139.        01  END-MSG.
  140.            05  CC             PIC X(1).
  141.            05  F1-THE-END     PIC X(43)    VALUE
  142.              'JOB ASSEMBLY REPORT - NO RECORDS TO PROCESS'.
  143.  
  144.  
  145.        01  EOF                PIC X(1)     VALUE 'N'.
  146.            88  NO-MORE-RECORDS             VALUE 'Y'.
  147.  
  148.  
  149.        01  COUNTERS-AND-STUFF.
  150.            05  LINE-CTR       PIC 9(2)     VALUE 99 USAGE IS COMP.
  151.              88  FULL-PAGE                 VALUE 35 THRU 99.
  152.            05  PAGE-NUMBER    PIC 9(3)     VALUE 0  USAGE IS COMP.
  153.            05  AD-ASM-TOTAL   PIC 9(4)V99  VALUE 0  USAGE IS COMP.
  154.            05  AD-JOB-TOTAL   PIC 9(5)V99  VALUE 0  USAGE IS COMP.
  155.            05  AD-FINAL-TOTAL PIC 9(6)V99  VALUE 0  USAGE IS COMP.
  156.  
  157.  
  158.        01  PREVIOUS-FIELDS.
  159.            05  PREV-JOB-NUM   PIC X(2).
  160.  
  161.  
  162.        01  PROGRAM-TABLES.
  163.            05  JOB-TABLE PIC X(13) OCCURS 4 TIMES.
  164.            05  JOB-CONSTANTS REDEFINES JOB-TABLE.
  165.               07  FILLER      PIC X(13)    VALUE 'IN WAREHOUSE '.
  166.               07  FILLER      PIC X(13)    VALUE 'NOT AVAILABLE'.
  167.               07  FILLER      PIC X(13)    VALUE 'ON ORDER     '.
  168.               07  FILLER      PIC X(13)    VALUE 'ON BACKORDER '.
  169.  
  170.  
  171.       ***********************************
  172.       * NOW FOR THE PROCEEEEDURE DIV.   *
  173.       ***********************************
  174.  
  175.        PROCEDURE DIVISION.
  176.        DRIVER-ROUTINE.
  177.            SORT    SORTWORK-FILE
  178.                    ASCENDING KEY SWR-JOB-NUM
  179.                    USING  SOURCE-FILE
  180.                    GIVING SORTED-FILE.
  181.            PERFORM OPEN-ROUTINE.
  182.            PERFORM READ-ROUTINE.
  183.            MOVE SF-JOB-NUMBER TO PREV-JOB-NUM.
  184.            PERFORM PROCESS-ROUTINE UNTIL NO-MORE-RECORDS.
  185.            PERFORM JOB-TOTAL-ROUTINE.
  186.            PERFORM TOTAL-ROUTINE.
  187.            PERFORM CLOSE-ROUTINE.
  188.            STOP RUN.
  189.  
  190.        OPEN-ROUTINE.
  191.            OPEN INPUT  SORTED-FILE.
  192.            OPEN OUTPUT PRINTER-FILE.
  193.            MOVE CURRENT-DATE TO H1-DATE.
  194.  
  195.  
  196.        READ-ROUTINE.
  197.            READ SORTED-FILE
  198.                 AT END
  199.                 MOVE 'Y' TO EOF.
  200.  
  201.        PROCESS-ROUTINE.
  202.            IF  FULL-PAGE
  203.                PERFORM HEADING-ROUTINE.
  204.  
  205.            MOVE SPACES TO DETAIL-LINE.
  206.  
  207.            IF  SF-JOB-NUMBER NOT = PREV-JOB-NUM
  208.                PERFORM JOB-TOTAL-ROUTINE.
  209.  
  210.            MOVE SF-JOB-NUMBER TO DL-JOB-NUM.
  211.            MOVE SF-SUB-ASM-NUM TO DL-ASM-NUM.
  212.  
  213.            MOVE JOB-TABLE (SF-SUB-ASM-CODE) TO
  214.                 DL-ASM-STAT.
  215.            MOVE SF-NEEDED TO DL-NEEDED.
  216.  
  217.            MULTIPLY SF-NEEDED BY SF-SUB-ASM-COST GIVING AD-ASM-TOTAL.
  218.            MOVE AD-ASM-TOTAL TO DL-TOTAL-COST.
  219.            ADD AD-ASM-TOTAL TO AD-JOB-TOTAL.
  220.  
  221.            ADD 1 TO LINE-CTR.
  222.            PERFORM READ-ROUTINE.
  223.  
  224.        HEADING-ROUTINE.
  225.            ADD 1 TO PAGE-NUMBER.
  226.            MOVE PAGE-NUMBER TO H1-PAGE-NUM.
  227.            WRITE PRINTER-RECORD FROM HEADING-1 AFTER PAGE.
  228.            WRITE PRINTER-RECORD FROM HEADING-2 AFTER 2.
  229.            WRITE PRINTER-RECORD FROM HEADING-3 AFTER 1.
  230.            MOVE SPACES TO PRINTER-RECORD.
  231.            WRITE PRINTER-RECORD AFTER 1.
  232.            MOVE 0 TO LINE-CTR.
  233.  
  234.        JOB-TOTAL-ROUTINE.
  235.            MOVE PREV-JOB-NUM TO T1-JOB-NUM.
  236.            MOVE AD-JOB-TOTAL TO T1-JOB-TOTAL.
  237.            WRITE PRINTER-RECORD FROM TOTAL-ONE AFTER 2.
  238.            MOVE SPACES TO PRINTER-RECORD.
  239.            WRITE PRINTER-RECORD AFTER 1.
  240.            ADD 3 TO LINE-CTR.
  241.            ADD AD-JOB-TOTAL TO AD-FINAL-TOTAL.
  242.            MOVE 0 TO AD-JOB-TOTAL.
  243.            MOVE SF-JOB-NUMBER TO PREV-JOB-NUM.
  244.  
  245.        TOTAL-ROUTINE.
  246.            MOVE AD-FINAL-TOTAL TO T2-FINAL-TOTAL.
  247.            WRITE PRINTER-RECORD FROM TOTAL-TWO AFTER 1.
  248.            WRITE PRINTER-RECORD FROM FINAL-LINE AFTER 2.
  249.            WRITE PRINTER-RECORD FROM END-MSG AFTER 1.
  250.  
  251.        CLOSE-ROUTINE.
  252.            CLOSE SORTED-FILE.
  253.            CLOSE PRINTER-FILE.
  254.  
  255.  
  256.